Developer CD Series 1992 June: ROMin Holiday

home *** CD-ROM | disk | FTP | other *** search

/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / Apple II / Essentials / Dynamo 4.2 for GSBug 1.5b10 / dynamo.sample / sample.a < prev next >

Wrap

Text File | 1990-09-21 | 14.2 KB | 774 lines | [TEXT/MPS ]

******************************************************* * * * Apple II 8-bit runtime sample exerciser. * * Copyright (C) 1990 Apple Computer. * * Version 4.1 * * * * Written by Eric Soldan, Apple II DTS * * * ******************************************************* include ':dynamo.includes:sys.equ' include ':dynamo.includes:rt.h' include ':dynamo.includes:rt.macros' include ':dynamo.includes:rtfp.macros' include 'app.config' ********************************************* export intspace intspace PROC export floatspace floatspace ds.b 256 endp ****************** export strspace strspace PROC export strlens, maxstrlens, strlocs strlens ds.b numstrings maxstrlens dc.b maxstr1, maxstr2 strlocs dc.w str1loc, str2loc endp ****************** part1 PROC export start import part2 jsr $C300 ;Initialize 80-col screen. _writecr jsr home start lda #0 ;Clear the variable space. tax ;This application does not @clearvars sta intspace,x ;need the variables to be inx ;pre-cleared. bne @clearvars jmp part2 endp ****************** part2 PROC _rtreset _hibitchrs _write '8-bit sample application demonstrating ',\ 'macros and runtime.',13,\ 'Copyright (C) 1990 by Apple Computer.',13,\ '<<< Version 4.1 >>>' _signed _write 13,13,13,13,' Testing signed output: ' _decout #-1 _unsigned _write 13,'Testing unsigned output: ' _decout #-1 _write 13,13,' Testing 1-byte decimal output: ' _decoutl #-1 _write 13,'Testing variable decimal output: ' _restore #intdata _readint var1 _vdecout _write 13,13,' hexpad default is to pad with 0''s: ' _vhexout _hexnopad _write 13,' Testing 2-byte hex output with no pad: ' _hexout #123 _hexpad #32 _write 13,'Testing 2-byte hex output padded with spaces: ' _hexout #123 _hexpad #'0' _writecr _write 13,' Testing 1-byte hex output padded with 0''s: ' _hexoutl #15 _hexnopad _write 13,' Testing 1-byte hex output with no pad: ' _hexoutl #15 _hexpad #32 _write 13,'Testing 1-byte hex output padded with spaces: ' _hexoutl #15 jsr nextPage _write 'Testing _addvar: 1234+5678=' _set var2,#5678 _set var1,#1234 _addvar ,var2 _vdecout _write 13,' Testing _addl: +123=' _addl ,#123 _vdecout _write 13,' Testing _add: +456=' _add ,#456 _vdecout _write 13,13,'Testing _subvar: 5678-1234=' _set var2,#1234 _set var1,#5678 _subvar ,var2 _vdecout _write 13,' Testing _subl: -123=' _subl ,#123 _vdecout _write 13,' Testing _sub: -456=' _sub ,#456 _vdecout _write 13,13,'Testing _mulvar: 12*345=' _set var2,#345 _set var1,#<12 _mulvar ,var2 _vdecout _write 13,' Testing _mull: *6=' _mull ,#6 _vdecout _write 13,' Testing _mul: *789=' _mul ,#789 _vdecout _write ' (Overflow -- loss of high-order bytes.)' _write 13,13,'Testing _divvar: 65432/23=' _set var2,#<23 _set var1,#65432 _divvar ,var2 _set remainder _vdecout var1 _write ' (Remainder=' _vdecout remainder _rtcout #')' _write 13,' Testing _divl: /34=' _divl var1,#34 _set remainder _vdecout var1 _write ' (Remainder=' _vdecout remainder _rtcout #')' _write 13,' Testing _div: /321=' _div var1,#321 _set remainder _vdecout var1 _write ' (Remainder=' _vdecout remainder _rtcout #')' _write 13,13,'Testing dereferencing ($1234 means good): $' _set var1,**@ptr1 ;var1 has address @ptr3 now. _add ,#<2 ;var1 has address @ptr3+2 now. _vderef ;var1 has address @ptr4 now. _vderef ;var1 has address @ptr5 now. _vderef ;var1 has value from @ptr5 now. _vhexout jmp @past @ptr1 dc.w @ptr2 @ptr2 dc.w @ptr3 @ptr3 dc.w 0,@ptr4 @ptr4 dc.w @ptr5 @ptr5 dc.w $1234 @past jsr nextPage _set var1,#345 _set0 var1 _write 'Testing _set0: ' _vdecout _set var2,#<2 _var var1 _varcpy ,var2 _write 13,'Testing _var and _varcpy (2 means good): ' _vdecout _set var1,#345 _setl ,#123 _write 13,'Testing _setl (123 means good): ' _vdecout _write 13,'Testing _setvars: ' _setvars var1,#123,var2,#456,var3,#789 _vdecout var1 _rtcout #',' _vdecout var2 _rtcout #',' _vdecout var3 _write 13,13,' Testing _maxswap (signed): ' _set var1,#-123 _signed _maxswap var1,var2 _vdecout _rtcout #',' _vdecout var2 _write 13,'Testing _maxswap (unsigned): ' _unsigned _maxswap var1,var2 _signed _vdecout _rtcout #',' _vdecout var2 _write 13,'Testing _minswap (unsigned): ' _unsigned _minswap var1,var2 _signed _vdecout _rtcout #',' _vdecout var2 _write 13,' Testing _minswap (signed): ' _minswap var1,var2 _vdecout _rtcout #',' _vdecout var2 _unsigned _write 13,13,'Testing _vsgncmp: -123<456?: ' _setvars var1,#-123,var2,#456 _vsgncmp var1,var2 bcc @a _write 'no' jmp @b @a _write 'yes' @b _write 13,' Testing _vcmp: -123<456?: ' _vcmp var1,var2 bcc @c _write 'no' jmp @d @c _write 'yes' @d _write 13,' Testing _sgncmp: -123<456?: ' _sgncmp var1,#456 bcc @e _write 'no' jmp @f @e _write 'yes' @f _write 13,' Testing _cmp: -123<456?: ' _cmp var1,#456 bcc @g _write 'no' jmp @h @g _write 'yes' @h _readend #0 _restore #strdata _readstr str1 _prstr _readstr str2 _strval _decout _readstr str1 _prstr _midstrval str2,#2 _decout _writecr _readstr str1 _prleftstr str1,#10 _prmidstr str1,#10,#5 _prmidstr str1,#15,#255 _writecr _readstr str1 _leftstrcpy str2,str1,#15 _prstr _midstrcpy ,str1,#15,#5 _prstr _midstrcpy ,str1,#20 _prstr _writecr _readstr str1 _strcpy str2,str1 _prstr _writecr _readstr str2 _readstr str1 _leftstrcat str2,str1,#10 _midstrcat ,str1,#10,#5 _midstrcat ,str1,#15 _prstr _writecr _readstr str1 _readstr str2 _strcat str1,str2 _prstr jsr nextPage _readstr str1 ldy #0 @loop cpy strlens+str1 beq @brkloop tya pha _strchr _rtcout pla tay iny bne @loop @brkloop _litstr str1,13,'Testing _litstr.' _prstr _write 13,'Testing _strloc: str1 is at $' _strloc str1 _hexout _write 13,13,'Testing _rndseed: value passed is: $' _hexnopad _hexout *rndl _rndseed *rndl _write 13,13,'Testing _random (200 numbers from 0 to 99):',13,13 ldx #10 @loopx stx tempx ldy #20 @loopy sty tempy _random #100 ;This random generator can not generate _decout ;a zero value. This is okay, since you lda #',' ;can't declare a limit in 2 bytes which ldy tempy ;would give you this range. (To get a dey ;high-end value of 65535, you would have bne @i ;to have a limit of 65536. lda #13 ;Adjustments for the algorithm not @i _rtcout ;generating a 0 value have been made. ldy tempy ;1 is subtracted from the value, thus dey ;moving the problem value from 0 to 65535. bne @loopy ;Since there is a limit on the 65535 value ldx tempx ;anyway, due to not being able to declare dex ;a limit of 65536, this works rather well. bne @loopx jsr nextPage _write 13,'Testing array handling.' _write 13,'The array is 2x512x2x4 words.' _array #$4000,#2,#2,#512,#2,#4 _index #<1,#379,#<1 _set var1,#1234 _putl ,#3 _index ,#<73 _set var1,#567 _put ,#<1 _set var1,#890 _putnext _write 13,13,'array(1,379,1,3)=' _index ,#379,#<1 _getl var1,#<3 _vdecout _write 13,'array(1, 73,0,1)=' _index ,#<73 _get var1,#<1 _vdecout _write 13,'array(1, 73,0,2)=' _getnext _vdecout jsr nextPage _write 'Testing floating-point support:',13 _write 13,' Ascii text for number is: -123.4567e8' _write 13,' Ascii to float variable (testing _fset): ' floattest _fset fvar1,#-123.4567e8 _hexpad #'0' _hexoutl *floattest+5 _rtcout #' ' _hexoutl *floattest+6 _rtcout #' ' _hexoutl *floattest+7 _rtcout #' ' _hexoutl *floattest+8 _rtcout #' ' _hexoutl *floattest+9 _write 13,' Output float variable (testing _fvout): ' _fvout _write 13,'Output multi-deref''ed float (testing _fout): ' _fout ***@fp jmp @pastptrs @fp dc.w @fp0 @fp0 dc.w floattest+5 @pastptrs _fset fvar1,#.123 _fmul ,#.456 _write 13,13,'Testing floating-point multiply: ',\ ' .123 * .456 = ' _fvout _fsetvars fvar1,#.456,fvar2,#.123 _fdivvar fvar1,fvar2 _write 13,' Testing floating-point divide: ',\ ' .456 / .123 = ' _fvout _fset fvar1,#12.34567e8 _fadd ,#.7654321e10 _write 13,' Testing floating-point add: ',\ '12.34567e8 + .7654321e10 = ' _fvout _fset fvar1,#55.555e-4 _fsub ,#.54321e-2 _write 13,'Testing floating-point subtract: ',\ ' 55.555e-4 - .54321e-2 = ' _fvout _i2fsetvars fvar1,#5,fvar2,#2 _fv2v fvar1,fvar2 _write 13,' Testing exponentation: ' _repeat #' ',#19 _write '5 ^ 2 = ' _fvout _restore #floatdata _readfloat fvar1 _readfloat fvar2 _fv2v fvar1,fvar2 _writecr _space #51 _write '16 ^ .5 = ' _fvout _fset fvar1,#2.71828183 _fv2con ,#3.14159265 _writecr _space #35 _write '2.71828183 ^ 3.14159265 = ' _fvout _write 13,13,'AppleSoft floating-point numbers ',\ 'will have slight rounding errors. This is to ',13,\ 'be expected. (Try it in AppleSoft.)',13,13 _write ' Testing _fcmp: -1.35e-9<-1.35e-8?: ' _fset fvar1,#-1.35e-9 _fcmp ,#-1.35e-8 bcs @a _write 'yes' jmp @b @a _write 'no' @b _write 13,'Testing _fvcmp: -1.35e-9>-1.35e-8?: ' _fset fvar2,#-1.35e-8 _fvcmp fvar1,fvar2 beq @c bcc @c _write 'yes' jmp @d @c _write 'no' @d jsr nextPage _write 'Testing float-to-int conversion: ',\ 'float signed int unsigned int',13 _space #36 _write '------- ---------- ------------',13 _space #36 _fset fvar1,#123.456 _fvout _f2i _signed _space #9 _vdecout _unsigned _space #13 _vdecout _writecr _space #35 _fset fvar1,#-123.456 _fvout _f2i _signed _space #8 _vdecout _unsigned _space #11 _vdecout _writecr _space #38 _fset fvar1,#65535 _fvout _f2i _signed _space #10 _vdecout _unsigned _space #11 _vdecout _writecr _space #38 _fset fvar1,#65536 _fvout _f2i _signed _space #11 _vdecout _unsigned _space #15 _vdecout _write 13,13,'Testing _fsgn: SGN(-123.456)=' _fset fvar1,#-123.456 _fsgn _fvout _write ' SGN(0)=' _fset0 fvar1 _fsgn _fvout _write ' SGN(123.456)=' _fset fvar1,#123.456 _fsgn _fvout _write 13,'Testing _fabs: ABS(-123.456)=' _fset fvar1,#-123.456 _fabs _fvout _write ' ABS(0)=' _fset0 fvar1 _fabs _fvout _write ' ABS(123.456)=' _fset fvar1,#123.456 _fabs _fvout _write 13,'Testing _fint: INT(-123.456)=' _fset fvar1,#-123.456 _fint _fvout _write ' INT(0)=' _fset0 fvar1 _fint _fvout _write ' INT(123.456)=' _fset fvar1,#123.456 _fint _fvout _write 13,13,'Testing _fsqr: SQR(64)=' _i2fset fvar1,#64 _fsqr _fvout _write ' SQR(123.456789)=' _fset fvar1,#123.456789 _fsqr _fvout _write 13,'Testing _flog: LOG(2.71828183)=' _fset fvar1,#2.71828183 _flog _fvout _write ' LOG(123.456789)=' _fset fvar1,#123.456789 _flog _fvout _write 13,'Testing _fexp: EXP(1)=' _i2fset fvar1,#1 _fexp _fvout _write ' EXP(10)=' _i2fset fvar1,#10 _fexp _fvout _write 13,13,'Testing _frnd: RND(1)=' _rndseed *rndl ;Generate a random int seed. _random #32768 pha ;Make it negative tya ora #$80 tay pla _i2fset fvar1 _frnd ;Pass negative float to random for seed. ldy #3 ;Do 3 random numbers. @e tya pha _rtcout #' ' _i2fset ,#1 ;We want a new random number. _frnd _fvout pla tay dey bne @e ;More random numbers to go. _write 13,13,'Testing _fcos: COS(0)=' _i2fsetvars fvar1,#0,fvar2,#1 _fcos fvar1 _fvout _write ' COS(pi/2)=' _fset ,#1.57079633 ;This pi/2 gives the least error. _fcos _fvout _write 13,'Testing _fsin: SIN(0)=' _fset0 ,#0 _fsin _fvout _write ' SIN(pi/2)=' _fset ,#1.57079633 ;This pi/2 gives the least error. _fsin _fvout _write 13,'Testing _ftan: TAN(0)=' _fset0 ,#0 _ftan _fvout _write ' TAN(pi/4)=' _fset ,#.785398164 _ftan _fvout _nullstr str1 ;Empty the string. _out2str ;Testing output redirection to a string. _out2str ;Testing that the out2stroff can handle ;two calls to out2str. _write 13,'Testing _fatn: ATN(0)=' _fset0 fvar1,#0 _fatn _fvout _write ' ATN(1e20)=' _litstr str2,'1e20' _fstrval _fset fvar2 _fvarcpy fvar1,fvar2 _fatn _fvout _out2stroff _prstr str1 jsr nextPage _write 13,'Testing floating-point error trapping:',\ 13,' 12.34/1 = ' _fset fvar1,#12.34 _fdiv ,#1 jsr aserror _write 13,' 12.34/0 = ' _fdiv ,#0 jsr aserror _write 13,' LOG(10) = ' _fset fvar1,#10 _flog jsr aserror _write 13,' LOG(-1) = ' _fset fvar1,#-1 _flog jsr aserror _write 13,' 20^20 = ' _fset fvar1,#20 _fv2con ,#20 jsr aserror _write 13,' 30^30 = ' _fset fvar1,#30 _fv2con ,#30 jsr aserror _write 13,13,13,'Testing floating-point array handling.' _write 13,'The array is 5x6x7 words.' _array #$4000,#5,#5,#6,#7 ;First #5 means elements are ;5 bytes each. _index #<1,#<2 _fset fvar1,#12.34 _putl ,#<3 _index ,#<4 _fset fvar1,#56.78 _put ,#<1 _write 13,13,'array(1,2,3)=' _index ,#<2 _getl fvar1,#<3 _fvout _write 13,'array(1,4,1)=' _index ,#<4 _get fvar1,#<1 _fvout jsr nextPage jmp start tempx dc.b 0 tempy dc.b 0 aserror bcc @noerr pha _write 'AppleSoft error $' _hexpad #'0' pla _hexoutl rts @noerr _fvout rts floatdata _asc2fp #16 _asc2fp #.5 intdata dc.w 123 strdata _cstr 13,13,'Testing _readend, _restore, ',\ '_readstr, and _strval: ' _cstr '12345' _cstr 13,'Testing _midstrval: ' _cstr 'Testing _prleftstr and _prmidstr.' _cstr 'Testing _leftstrcpy and _midstrcpy.' _cstr 'Testing _strcpy.' _cstr 0,'Testing _leftstrcat and _midstrcat.' _cstr 'Testing ' _cstr '_strcat.' _cstr 13,'Testing _strchr.' nextPage lda #22 sta cv _write 13,' <<< Press any key to go on (or ESC to quit). >>>' bit $C010 @a inc rndl bne @b inc rndh @b lda $C000 bpl @a bit $C010 cmp #$9B beq @quit jmp home @quit jsr home jsr mli dc.b $65 dc.w @quitlist @quitlist dc.b 4 dc.w 0,0,0 endp END